作品置き場

文字列を利用した演算（プログラム本体）

-- chapter 4
import Char -- ord を使うため。
data Expr = Num Numeral
| Var Ide
| Let [Decl] Expr
| Bexpr BinOpr Expr Expr
| Rexpr RelOpr Expr Expr
| If Expr (Expr, Expr)
| Fun Ide Expr
| Apply Expr Expr

data BinOpr = Plus | Minus | Times | Over

data RelOpr = Equal | NotEqual
| Greater | GreaterEq
| Less | LessEq

data Decl = Decl Ide Expr
type Numeral = [Char]

type Ide = [Char]

-- 結果を表示するための関数 expval1 。

expval1 :: Expr -> Env -> [Char]
expval1 e r = printval (expval e r)
printval :: Val -> [Char]
printval (V_Int n) = "V_Int " ++ (show n)
printval (V_Bool n) = "V_Bool " ++ (show n)

expval :: Expr -> Env -> Val
expval (Num n) r = V_Int (numval n)
expval (Var x) r = lookup1 r x
expval (Let ds e) r = expval e (recdecl ds r)
expval (Bexpr o e e') r = V_Int (binopr o v v')
where
V_Int v = expval e r
V_Int v' = expval e' r
expval (Rexpr o e e') r = V_Bool (relopr o v v')
where
V_Int v = expval e r
V_Int v' = expval e' r
expval (If e (e', e'')) r | v = expval e' r
| otherwise = expval e'' r
where
V_Bool v = expval e r
expval (Fun x e) r = V_Fun f
where
f v = expval e (update r x v)
expval (Apply e e') r = f (expval e' r)
where
V_Fun f = expval e r

recdecl :: [Decl] -> Env -> Env
recdecl ds r = r''
where
r'' = foldl declenv' r ds
declenv' r' d = declenv d r r'

declenv :: Decl -> Env -> Env -> Env
declenv (Decl x e) r' r = update r x (expval e r')

binopr :: BinOpr -> Int -> Int -> Int
binopr Plus = (+)
binopr Minus = (-)
binopr Times = (*)
binopr Over = div

relopr :: RelOpr -> Int -> Int -> Bool
relopr Equal = (==)
relopr NotEqual = (/=)
relopr Greater = (>)
relopr GreaterEq = (>=)
relopr Less = (<)
relopr LessEq = (<=)

numval :: Numeral -> Int
numval n = foldl ttp 0 (conversion n)
ttp :: Int -> Int -> Int
ttp a b = a*10 + b
digval :: Char -> Int
digval d = ord d - ord '0'

conversion :: Numeral -> [Int]
conversion (x:xs) = ((digval x):[]) ++ conversion xs
conversion[] = []



type Env = Assoc Ide Val
data Val = V_Int Int
| V_Bool Bool
| V_Fun (Val -> Val)

type Assoc a b = a -> b

none :: Assoc a b
none x = undefined

lookup1 :: Assoc a b -> a -> b
lookup1 h x = h x

update :: Eq a => Assoc a b -> a -> b -> Assoc a b
update h x v y | x == y = v
| otherwise = lookup1 h y